L' Effet Pommier 3/L'Effet Pommier - Volume 03.iso/Graphismes/Bitmap/NIH Image 1.59/Macros/Corpus Collosum Macros

Text File | 1993-11-03 | 4KB | 207 lines

{
This is a set of macros for measuring the area of various regions in the corpus collosum in MRI scans. It assumes that the scans are 256x256, that you are using a 19" monitor, that the Undo buffer is set to 600K, and that you have a lot of RAM.

This is the procedure:

1) Open or activate the scan to be analyzed and type Z.
2) Draw a base line using the line tool.
3) Draw perpendicular lines by typing S or R.
4) Draw a perpendicular line at an arbitrary location by clicking
   on the base line with the line tool and typing A.
5) Outline the corpus collosum.
6) Threshold by typing B.
7) Measure the areas by clicking inside each region with the wand.
8) Revert to grayscale by typing G. (Optional)
9) Dispose of the 768x768 working window by typing D.
}

var  {Global variables}
  WindowNum:integer;
  x1,y1,x2,y2,LineWidth:integer;
  size,angle,dx,dy,pi,theta:real;
  width,height,dx,dy,i:integer;


macro 'Zoom Window [Z]';
var
  top,left,width,height:integer;
begin
  RequiresVersion(1.50);
  if UndoBufferSize<(768*768) then begin
    PutMessage('Use Preferences(Options Menu) to increase the Undo buffer size to at least 600K.');
    exit;
  end;
  GetPicSize(width,height);
  if width>600 then begin
    PutMessage('Window has already been zoomed.');
    exit;
  end;
  KillRoi;
  SetScale(1,'mm'); {Assume 1 pixel/mm}
  WindowNum:=PicNumber;
  SetScaling('Nearest; New Window');
  ScaleAndRotate(3,3,0);
  ChangeValues(254,255,253); {Reserve 254-255(black) for graphics}
  SetForegroundColor(254);
  ApplyLUT;
  SetLineWidth(1);
end;


procedure DrawPerpendicularLine(x,y:integer);
begin
  moveto(x,height-y);
  lineto(x+size*cos(theta+angle),height-(y+size*sin(theta+angle)));
  moveto(x,height-y);
  lineto(x+size*cos(theta-angle),height-(y+size*sin(theta-angle)));
end;


procedure DrawLines(nSegments:integer);
begin
  for i:=1 to nSegments-1 do
    DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawLeftLine;
var
  nSegments,i:integer;
begin
  nSegments:=5;
  i:=1;
  DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawRightLine;
var
  nSegments,i:integer;
begin
  nSegments:=5;
  i:=4;
  DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawThePerpendiculars;
begin
  GetLine(x1,y1,x2,y2,LineWidth);
  if (x1<0) or ((x2-x1)<10) then begin
    PutMessage('Select the base line first using the line selection tool.');
    exit;
  end;
  Fill;
  KillRoi;
  size:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  angle:=90; {degrees}
  pi:=3.14159;
  GetPicSize(width,height);
  y1:=height-y1;
  y2:=height-y2;
  angle:=(angle/180)*pi;
  dx:=x1-x2;
  dy:=y1-y2;
  if dx=0 then begin
    if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  end else begin
    theta:=arctan(dy/dx);
    if dx<0 then theta:=theta+pi;
  end;
  dx:=x2-x1;
  dy:=y2-y1;
  SetForegroundColor(255);
  DrawLines(2);
  DrawLines(3);
end;


Macro 'Draw Perpendicular Lines-Left[S]';
begin
  DrawThePerpendiculars;
  DrawLeftLine;
end;


Macro 'Draw Perpendicular Lines-Right[R]';
begin
  DrawThePerpendiculars;
  DrawRightLine;
end;


macro 'Draw Arbitrary Perpendicular Line [A]';
var
  xx1,yy1,xx2,yy2:integer;
  fraction:real;
begin
  if angle=0 then begin
    PutMessage('Draw the other perpendiclular lines first.');
    exit;
  end;
  if dx=0 then begin
    PutMessage('Draw base line first.');
    exit;
  end;
  GetLine(xx1,yy1,xx2,yy2,LineWidth);
  if not ((xx1>x1) and (xx1<x2)) then begin
    PutMessage('Click with the line selection tool first.');
    exit;
  end;
  KillRoi;
  fraction:=(xx1-x1)/dx;
  DrawPerpendicularLine(x1+round(dx*fraction),y1+round(dy*fraction));
end;


macro 'Make Binary [B]';
var
  top,left,width,height:integer;
begin
  GetRoi(top,left,width,height);
  if width=0 then begin
    PutMessage('Please outline first.');
    exit;
  end;
  DrawBoundary;
  KillRoi;
  SetThreshold(255);
  SetOptions('Area');
  LabelParticles(false);
  IncludeInteriorHoles(true);
  WandAutoMeasure(true);
  ResetCounter;
  ShowResults;
end;

macro 'Make Grayscale [G]';
begin
  ResetGrayMap;
  KillRoi;
end;

macro 'Dispose of Window [D]';
var
  width,height:integer;
begin
  GetPicSize(width,height);
  if width>600
    then dispose
    else exit;
  if windowNum<>0 then SelectPic(WindowNum);
end;

macro 'Adjust Areas [Q]';
var
  i:integer;
begin
  for i:=1 to rCount do
    rArea[i]:=rArea[i]/9;
  ShowResults;
end;